home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / swap.em < prev    next >
Lisp/Scheme  |  1992-10-06  |  1KB  |  41 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                           ;;
  3. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  4. ;;                                                                           ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. (defmodule swap
  8.  
  9.   ( standard) ()
  10.  
  11.   ()
  12.  
  13.   (deflocal *thread* nil)
  14.   (deflocal *signal* nil)
  15.  
  16.   (defun wait-until (f) (if (f) t (wait-until f)))
  17.  
  18.   (defun swap ()
  19.     (format t "Swapping...") (flush (standard-output-stream))
  20.     (setq *thread* nil)
  21.     (setq *signal* nil)
  22.     (let ((th (make-thread caller)))
  23.       (thread-start th)
  24.       (wait-until (lambda () *signal*))
  25.       (setq *thread* (current-thread))
  26.       (thread-suspend))
  27.     (format t " swapped.~%") (flush (standard-output-stream))
  28.     nil)
  29.  
  30.   (defun caller () 
  31.     (setq *signal* t)
  32.     (wait-until (lambda () *thread*))
  33.     (system "sleep 1")
  34.     (thread-start *thread*))
  35.  
  36.   (export swap)
  37.  
  38. )
  39.  
  40.     
  41.